home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Memphis Amiga Group / MAG Disk (1989-11)(Memphis Amiga Group).zip / MAG Disk (1989-11)(Memphis Amiga Group).adf / HeadClean / hc_main < prev    next >
Text File  |  1986-11-06  |  8KB  |  297 lines
  1. \ Clean a drive by trying to format several cylinders
  2. \ on a fibre cleaning disk
  3. \ The last cylinder used will be kept in a file called
  4. \   HEADCLEAN.LOG
  5.  
  6. \ Author: Phil Burk
  7. \ Copyright 1987,8,9 Phil Burk
  8. \
  9. \ This program is a freely redistributable shareware program.
  10.  
  11. ANEW TASK-HC_MAIN
  12.  
  13. \ ----------------------------------------------------
  14. \ Graphical User Interface Portion of code.
  15.  
  16. \ Support for GO gadget.
  17. : HC.ALL.USED ( -- )
  18.     " This disk is used up. You may want to buy a new one."
  19.     $HC.MSG
  20.     0 clean-start !
  21. ;
  22.  
  23. : CHECK.START ( -- , correct start cylinder if bad )
  24.     clean-start @ NUMCYLS 1- clean_#cyl - >
  25.     IF hc.all.used
  26.     THEN
  27. ;
  28.  
  29. variable FORCE-WRITE  ( force writing of new HeadClean.LOG file )
  30.  
  31. : HC.GO  ( -- , clean disk
  32.     check.start
  33.     <headclean>
  34.     IF force-write on  ( if cylinders used )
  35.        clean-drive @ hc.mark.drive  ( mark as cleaned )
  36.     THEN
  37.     check.start
  38. ;
  39.  
  40. \ ------------------------------------------------
  41. \ Support for HELP gadget.
  42. variable HC-CURY
  43.  
  44. : HC.LINE  ( text -- , new line of graphics )
  45.     10 hc-cury @ gr.move
  46.     gr.text
  47.     hc_line_height hc-cury +!
  48. ;
  49.  
  50. variable HC-WINDOW
  51.  
  52. : HC.HELP.TEXT1 ( -- , display first help screen )
  53.     1 gr.color!
  54.     hc_banner_y1 hc-cury !  ( set y pos )
  55.     " HeadClean V2.0 is designed to work with any fibre" hc.line
  56.     " cleaning disk.  3.5 inch, double sided, cleaning" hc.line
  57.     " disks are available from many stores including" hc.line
  58.     " Radio Shack for around $10.00. Every cleaning will" hc.line
  59.     " use 4 cylinders of the disk. The next cylinder" hc.line
  60.     " to use will be written to the file HeadClean.LOG." hc.line
  61.     " When every cylinder has been used you may want" hc.line
  62.     " to buy a new cleaning disk, or keep using it over" hc.line
  63.     " and over.  Clean your heads after every 40 hours" hc.line
  64.     " of use, or if you start getting Read/Write errors." hc.line
  65.     "  " hc.line
  66.     " Click in CloseBox for instructions." hc.line
  67. ;
  68.  
  69. : HC.HELP.TEXT2 ( -- )
  70.     0 gr.color!
  71.     2 10 hc_window_w 10 - 150 gr.rect
  72.     1 gr.color!
  73.     hc_banner_y1 hc-cury !
  74.     " How to clean your disk drive:" hc.line
  75.     "   1) Apply cleaning fluid to special cleaning disk" hc.line
  76.     "      based on instructions that came with it." hc.line
  77.     "   2) Insert cleaning disk in drive to be cleaned." hc.line
  78.     "   3) Select same drive with mouse in Headclean 2.0." hc.line
  79.     "   4) Click on 'Go' button and wait about 30 seconds." hc.line
  80.     "  " hc.line
  81.     3 gr.color!
  82.     " If you buy a new disk, hit the 'New' button which" hc.line
  83.     " will reset the cylinder counter." hc.line
  84.     "  " hc.line
  85.     1 gr.color!
  86.     " Click in CloseBox for more information." hc.line
  87. ;
  88.  
  89. : HC.HELP.TEXT3 ( -- )
  90.     0 gr.color!
  91.     2 10 hc_window_w 10 - 150 gr.rect
  92.     1 gr.color!
  93.     hc_banner_y1 hc-cury !
  94.     " HeadClean was written using JForth Professional 2.0," hc.line
  95.     " a powerful and fast interactive programming language." hc.line
  96.     " For more information, write or phone:" hc.line
  97.     3 gr.color!
  98.     "  " hc.line
  99.     "     Delta Research" hc.line
  100.     "     P.O. Box 1051" hc.line
  101.     "     San Rafael, CA, 94915" hc.line
  102.     "     (415) 485-6867" hc.line
  103.     "  " hc.line
  104.     1 gr.color!
  105.     " HeadClean V2.0 is shareware.  If you find this" hc.line
  106.     " program useful please send a check for $10.00" hc.line
  107.     " payable to Phil Burk at the above address." hc.line
  108.     " HeadClean V2.0 may be freely restributed." hc.line
  109. ;
  110.  
  111. newWindow HC-NewWindow
  112.  
  113. : HC.HELP ( -- , Draw explanatory help in separate window )
  114.     hc-newwindow newwindow.setup
  115.     hc_window_w hc-NewWindow ..! nw_width
  116.     160 hc-NewWindow ..! nw_height
  117. \
  118. \ Don't use GIMMEZEROZERO for speedier window dragging.
  119.     WINDOWDRAG WINDOWCLOSE | WINDOWDEPTH |
  120.     REPORTMOUSE | ACTIVATE | hc-newwindow ..! nw_flags
  121. \
  122. \ Set new title.
  123.     0" HeadClean Help"
  124.         >abs  hc-NewWindow ..! nw_title
  125. \
  126.     hc-NewWindow gr.opencurw
  127.     IF  hc.help.text1
  128.         BEGIN ?closebox
  129.         UNTIL
  130.         hc.help.text2
  131.         BEGIN ?closebox
  132.         UNTIL
  133.         hc.help.text3
  134.         BEGIN ?closebox
  135.         UNTIL
  136. \
  137.         gr.closecurw
  138. \
  139.         hc-window @ ?dup
  140.         IF gr.set.curwindow
  141.         THEN
  142.     ELSE " Insufficient memory for HELP window!" $hc.msg
  143.     THEN
  144. ;
  145.  
  146. \ Reset cleaning log. ----------------------------------
  147. : HC.NEW  ( -- )
  148.     clean-start off
  149.     force-write on
  150.     " Next cylinder counter reset to zero." $hc.msg
  151. ;
  152.  
  153. \ Main Graphics support --------------------------------
  154. : HC.DRAW.BANNER ( -- )
  155.     1 gr.color!
  156.     hc_banner_y1 hc-cury !
  157.     " Written by Phil Burk using JForth Professional 2.0"
  158.     hc.line
  159.     " from Delta Research, Box 1051, San Rafael, CA, 94915"
  160.     hc.line
  161.     3 gr.color!
  162.     "       Hit 'Help' button for instructions."
  163.     hc.line
  164.     1 gr.color!
  165. ;
  166.  
  167. : HC.DRAW.MAIN  ( -- , redraw graphics )
  168.     1 gr.color!
  169.     hc.draw.banner
  170.     hc.report.left
  171.     hc.show.drive
  172.     gt.refresh
  173. ;
  174.  
  175. : HC.GADS.INIT ( -- , initialize gadgets for demo )
  176. \  define border of gadgets.
  177.     boolg-xys >abs boolg-border ..! bd_xy
  178. \ Make border bigger then select region.
  179.     hc_w_h 2+ swap 2+ swap boolg-border border.setup
  180. \
  181. \ Declare text, CFA, and size for each gadget.
  182.     0 first-gadget !
  183.     ' hc.go      0" Go!"
  184.     hc_gadget_x hc_gadget_inc 5 * + hc_gadget_y hc_w_h  gt.gad.make
  185.     ' hc.help    0" Help"
  186.     hc_gadget_x hc_gadget_inc 6 * + hc_gadget_y hc_w_h  gt.gad.make
  187.     ' hc.new     0" New"
  188.     hc_gadget_x hc_gadget_inc 7 * + hc_gadget_y hc_w_h  gt.gad.make
  189. \
  190.     drive.buttons.init
  191. \
  192. \ Set defaults for newwindow
  193.     hc-NewWindow newwindow.setup
  194.     hc_window_w hc-NewWindow ..! nw_width
  195.     hc_window_h hc-NewWindow ..! nw_height
  196. \
  197. \ Don't use GIMMEZEROZERO for speedier window dragging.
  198.     WINDOWDRAG WINDOWCLOSE | WINDOWDEPTH |
  199.     REPORTMOUSE | ACTIVATE | hc-newwindow ..! nw_flags
  200. \
  201. \ Link gadget list to window.
  202.     first-gadget @ >abs hc-NewWindow ..! nw_firstgadget
  203. \
  204. \ Set new title.
  205.     0" -< HeadClean V2.0 -- Shareware >-"
  206.         >abs  hc-NewWindow ..! nw_title
  207. \
  208. \ Set flags for gadget events.
  209.     CLOSEWINDOW  GADGETDOWN | GADGETUP |
  210.     hc-NewWindow ..! nw_idcmpflags
  211. ;
  212.  
  213. : HC.LOOP  ( -- , process mouse events until done )
  214.     BEGIN
  215.         gr-curwindow @ ev.wait
  216.         gr-curwindow @ ev.getclass dup
  217.         IF gt.process.event ( -- done? )
  218.         THEN
  219.     UNTIL
  220. ;
  221.  
  222. \ Read and write starting cylinder to a log file --------------
  223. : HC_FILENAME ( -- $name )
  224.     " HeadClean.log"
  225. ;
  226.  
  227. : HC.READ.START ( -- , read start from log file or set to -1 )
  228.     hc_filename $fopen ?dup
  229.     IF  dup clean-start 4 fread 4 -  ( unformatted 4 byte read )
  230.         IF " Could not find HeadClean.log file. Start at 0"
  231.            $HC.MSG
  232.            0 clean-start !
  233.         THEN
  234.         fclose
  235.     ELSE  " Could not find HeadClean.log file. Start at 0"
  236.            $HC.MSG
  237.            0 clean-start !
  238.     THEN
  239.     force-write off
  240. ;
  241.  
  242. : HC.WRITE.START ( -- , write start to log file or set to -1 )
  243.     force-write @
  244.     IF  " Write next cylinder number to disk." $hc.msg
  245.         new hc_filename $fopen ?dup
  246.         IF  dup clean-start 4 fwrite drop  ( unformatted 4 byte read )
  247.             fclose
  248.         THEN
  249.         force-write off
  250.     THEN
  251. ;
  252.  
  253. \ Main control words ----------------------------
  254. \ I strongly recommend structuring your programs
  255. \ with a separate INIT and TERM word
  256. \ and a simple Main word that does both.
  257. \ This greatly simplifies testing bacause
  258. \ you can INIT completely then test interactively
  259. \ withou running the program.
  260.     
  261. : HC.INIT  ( -- ok? , initialize EVERYTHING )
  262.     graphics?
  263.     intuition?
  264.     gr.init
  265.     hc.gads.init
  266.     hc-NewWindow gr.opencurw dup
  267.     IF  gr-curwindow @ hc-window !
  268.         hc.read.start
  269.         check.start
  270.         arrow.init
  271.         0 hc.drive
  272.     hc.draw.main
  273.     THEN
  274. ;
  275.  
  276. : HC.TERM ( -- , clean up SAFELY )
  277.     arrow.term
  278.     gr.closecurw
  279.     hc-window off
  280.     gt.free.all
  281.     intuition?
  282.     graphics?
  283. ;
  284.  
  285. : HEADCLEAN ( -- , main entry point )
  286.     hc.init
  287.     IF  hc.loop
  288.         hc.write.start
  289.     THEN
  290.     hc.term
  291. ;
  292.  
  293. \ Automatically clean up if FORGET used.
  294. if.forgotten HC.TERM
  295.  
  296. cr ." Enter:   HEADCLEAN     to clean drive heads." cr
  297.